home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 20 / 9 / DISK2092.ZIP / RBBS-LIT.ZIP / LIT / VARCBAS.LIT < prev    next >
Text File  |  1989-07-25  |  2KB  |  61 lines
  1. *[VARCBAS.LIT]****************************************************************
  2. * Description: Forces BASIC routines to view archive contents.               *
  3. * RBBS-PC Level: CPC17.2B                                                    *
  4. * Module Affected: RBBSSUB4.BAS                                              *
  5. * Selection Option: ASMVIEWARC = OFF                                         *
  6. * Additional files: None                                                     *
  7. ******************************************************************************
  8. 64600 SUB VIEWARC STATIC
  9.       CLOSE 2
  10.       IF SHARE.IT THEN _
  11.          OPEN FILE.NAME$ FOR RANDOM SHARED AS #2 LEN=1 _
  12.       ELSE OPEN "R",2,FILE.NAME$,1
  13.       FIELD 2,1 AS CHAR$
  14.       BYTE.POINTER! = 1
  15.       ARC.END! = LOF(2)
  16. 64605 IF BYTE.POINTER! > ARC.END! THEN _
  17.          GOTO 64620
  18.       GET 2,BYTE.POINTER!
  19.       IF CHAR$ <> CHR$(26) THEN _
  20.          GOTO 64620
  21.       BYTE.POINTER! = BYTE.POINTER! + 1
  22.       GET 2,BYTE.POINTER!
  23.       IF CHAR$ = CHR$(0) THEN _
  24.          GOTO 64620
  25.       ARCED.NAME$ = ""
  26.       FOR X = 1 TO 12
  27.          GET 2,BYTE.POINTER! + X
  28.          IF CHAR$ < CHR$(40) THEN _
  29.             GOTO 64610
  30.          ARCED.NAME$ = ARCED.NAME$ + _
  31.                        CHAR$
  32.       NEXT
  33. 64610 A$ = ARCED.NAME$
  34.       BYTE.POINTER! = BYTE.POINTER! + 14
  35.       GOSUB 64630
  36.       TOTAL.BYTES# = WORK.BYTES#
  37.       BYTE.POINTER! = BYTE.POINTER! + 10
  38.       GOSUB 64630
  39.       FINAL.BYTES# = WORK.BYTES#
  40.       A$ = A$ + _
  41.            SPACE$(20 - LEN(ARCED.NAME$) - LEN(STR$(FINAL.BYTES#))) + _
  42.            STR$(FINAL.BYTES#) + _
  43.            " bytes."
  44.       CALL QTPUT1 (A$)
  45.       BYTE.POINTER! = BYTE.POINTER! + TOTAL.BYTES# + 4
  46.       GOTO 64605
  47. 64620 CLOSE 2
  48.       SUBROUTINE.PARAMETER = 0
  49.       CALL CARRIER
  50.       A$ = ""
  51.       EXIT SUB
  52. 64630 FACTOR# = 1#
  53.       WORK.BYTES# = 0
  54.       FOR X = 0 TO 3
  55.          GET 2,BYTE.POINTER! + X
  56.          WORK.BYTES# = WORK.BYTES# + FACTOR# * ASC(CHAR$)
  57.          FACTOR# = FACTOR# * 256#
  58.       NEXT
  59.       RETURN
  60.       END SUB
  61.